home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / menurtns.zip / MENUDEMO.BAS next >
BASIC Source File  |  1990-07-21  |  8KB  |  192 lines
  1. '*************************************************
  2. '*           Menu Routine Demo Program           *
  3. '*                                               *
  4. '*     Written by: Robert R. Smith               *
  5. '*     3812 Red Bud, Imperial MO  63052-1161     *
  6. '*************************************************
  7. '*                                               *
  8. '* Start up QuickBASIC with following parameters *
  9. '*                                               *
  10. '*        QB/l [drive:][\path]menurtns           *
  11. '*                                               *
  12. '*************************************************
  13.  
  14. DEFINT A-Z
  15. 'Define Constants
  16.  
  17. CONST True = 1
  18. CONST False = NOT True
  19.    
  20. CONST Black = 0
  21. CONST Blue = 1
  22. CONST Green = 2
  23. CONST Cyan = 3
  24. CONST Red = 4
  25. CONST Magenta = 5
  26. CONST Brown = 6
  27. CONST White = 7
  28. CONST Bright = 8
  29. CONST Blink = 16
  30. CONST Yellow = Brown + Bright
  31.  
  32. 'Declare Functions
  33.  
  34. DECLARE FUNCTION GetDate$ ()
  35. DECLARE FUNCTION GetTime$ ()
  36. DECLARE FUNCTION MenuBar% (Row%, Col%, MenuStr$, MenuFore%, MenuBack%, Reversed%)
  37. DECLARE FUNCTION MenuWindow% (Row%, Col%, ShadDir$, MenuTitle$, MenuStr$, OutLine%, WColor%, WText%, Reversed%)
  38. DECLARE FUNCTION Shadow% (Row%, Col%)
  39. DECLARE FUNCTION WaitKey$ (Row%, Col%, WaitText$)
  40.  
  41. 'Delcare Sub Routines
  42.  
  43. DECLARE SUB DrawBox (URow%, UCol%, LRow%, LCol%, ShadDir$, MenuTitle$, OutLine%, WColor%, WText%)
  44.  
  45. Esc$ = CHR$(27)
  46. Up$ = CHR$(0) + CHR$(72)
  47. PgUp$ = CHR$(0) + CHR$(73)
  48. Down$ = CHR$(0) + CHR$(80)
  49. PgDn$ = CHR$(0) + CHR$(81)
  50.  
  51. KEY OFF
  52. COLOR White, Blue
  53. CLS
  54.  
  55. 'Main loop
  56.  
  57. CONST MainMenu$ = " Documentation  Menu·window  Time·display  Date·display  Quit "
  58. CONST Menu$ = " Shadow·box  Menu·window·2  Time·display  Date·display  Quit "
  59. CONST SecondMenu$ = " Third·window·menu  Middle·choice  Last·choice  Quit "
  60. CONST ThirdMenu$ = " This·is·the·first·choice·of·the·third·menu  An·interesting·combination·of·functions  Quit·menu "
  61. CONST Numbers$ = "A B C D E F G Q"
  62.  
  63. VIEW PRINT 1 TO 25
  64.  
  65. DO
  66.    LOCATE , , 0
  67.      
  68.    MainTitle$ = "This menu is a combination of a MenuBar and Window"
  69.    CALL DrawBox(2, 9, 4, 74, "l", MainTitle$, Blue, Cyan, White + Bright)
  70.    SELECT CASE MenuBar%(3, 11, MainMenu$, Black, Cyan, Red + Bright)
  71.                       
  72.       CASE 1      'This if a demonstration of shadowed box
  73.          COLOR White, Blue
  74.          CLS
  75.          CALL DrawBox(9, 25, 13, 56, "L", "", Brown + Bright, Magenta, White + Bright)
  76.          COLOR White + Bright, Magenta
  77.          LOCATE 10, 29: PRINT "Please get printer ready"
  78.          Dummy$ = WaitKey$(12, 29, "Press any key to continue")
  79.          COLOR , Blue
  80.          CLS
  81.          CALL DrawBox(9, 25, 11, 56, "L", "", Brown + Bright, Magenta, White + Bright)
  82.          COLOR White + Bright, Magenta
  83.          LOCATE 10, 28, 0: PRINT "Printing.....Please Wait!!"
  84.          SHELL "TYPE A:\MENURTNS.DOC > PRN"
  85.          LPRINT CHR$(12)
  86.          CLS
  87.                          
  88.       CASE 2      'This if the new Window Menu selection
  89.          COLOR White, Blue
  90.          DO
  91.             FirstMenu$ = "N"
  92.             SELECT CASE MenuWindow%(14, 10, "", "Menu·Window", Menu$, Cyan + Bright, Cyan, White + Bright, Blue)
  93.                CASE 1
  94.                   CALL DrawBox(7, 30, 22, 65, "R", "Right Shadowed Box", Yellow, Brown, White + Bright)
  95.                CASE 2
  96.                   DO
  97.                      EndSecondMenu$ = "N"
  98.                      SELECT CASE MenuWindow%(11, 23, "l", "Menu·Window·2", SecondMenu$, Green + Bright, Green, Yellow, White + Bright)
  99.                         CASE 1
  100.                            DO
  101.                               EndThirdMenu$ = "N"
  102.                               SELECT CASE MenuWindow%(7, 14, "r", "Third Test Window", ThirdMenu$, Blue + Bright, Cyan, Black, Red)
  103.                                  CASE 1
  104.                                  CASE 2
  105.                                     DO
  106.                                        EndLastMenu$ = "N"
  107.                                        CALL DrawBox(12, 53, 21, 75, "L", "Interesting Combo", Yellow, Magenta, White + Bright)
  108.                                        COLOR White, Magenta
  109.                                        LOCATE 13, 55: PRINT "Menu Bar"
  110.                                        LOCATE 14, 55: PRINT "Second Option"
  111.                                        LOCATE 15, 55: PRINT "Third Option"
  112.                                        LOCATE 16, 55: PRINT "Fourth Option"
  113.                                        LOCATE 17, 55: PRINT "Fifth Option"
  114.                                        LOCATE 18, 55: PRINT "Sixth Option"
  115.                                        LOCATE 19, 55: PRINT "Last Option"
  116.                                        LOCATE 20, 55: PRINT "Quit"
  117.                                        SELECT CASE MenuWindow%(12, 47, "L", "", Numbers$, Yellow, Magenta, White + Bright, Black)
  118.                                           CASE 1
  119.                                              SELECT CASE MenuBar%(19, 15, Menu$, Black, Cyan, Red + Bright)
  120.                                              END SELECT
  121.                                           CASE 2
  122.                                           CASE 3
  123.                                           CASE 4
  124.                                           CASE 5
  125.                                           CASE 6
  126.                                           CASE 7
  127.                                           CASE ELSE
  128.                                              EndLastMenu$ = "Y"
  129.                                        END SELECT
  130.                                     LOOP UNTIL EndLastMenu$ = "Y"
  131.                                  CASE ELSE
  132.                                     EndThirdMenu$ = "Y"
  133.                               END SELECT
  134.                            LOOP UNTIL EndThirdMenu$ = "Y"
  135.                         CASE 2
  136.                         CASE 3
  137.                         CASE ELSE
  138.                            EndSecondMenu$ = "Y"
  139.                      END SELECT
  140.                   LOOP UNTIL EndSecondMenu$ = "Y"
  141.                CASE 3      'This would be the Equipment selection
  142.                   COLOR White, Blue
  143.                   LOCATE 22, ((80 - LEN(GetTime$)) / 2) - 10
  144.                   PRINT GetTime$; " at time of key press";
  145.                
  146.                CASE 4      'This would be the Color·attributes selection
  147.                   COLOR White, Blue
  148.                   LOCATE 23, ((80 - LEN(GetDate$)) \ 2) - 10
  149.                   PRINT GetDate$; " at time of key press"
  150.  
  151.                CASE ELSE
  152.                   FirstMenu$ = "Y"
  153.             END SELECT
  154.          LOOP UNTIL FirstMenu$ = "Y"
  155.          COLOR White, Blue
  156.          'CLS
  157.                          
  158.       CASE 3
  159.          COLOR White, Blue
  160.          CLS
  161.          LOCATE 12, 28: PRINT "Press any key to continue"
  162.          Response$ = ""
  163.          DO
  164.             Response$ = INKEY$
  165.             LOCATE 10, 25: PRINT "The current time is now "; GetTime$
  166.          LOOP WHILE Response$ = ""
  167.          CLS
  168.        
  169.       CASE 4
  170.          COLOR White, Blue
  171.          CLS
  172.          LOCATE 12, 28: PRINT "Press any key to continue"
  173.          Response$ = ""
  174.          DO
  175.             Response$ = INKEY$
  176.             LOCATE 10, 25: PRINT "Today's date is "; GetDate$
  177.          LOOP WHILE Response$ = ""
  178.          CLS
  179.         
  180.       CASE ELSE   'Exit loop
  181.          quitFlag% = True
  182.                          
  183.    END SELECT
  184. LOOP UNTIL quitFlag%
  185.   
  186. 'Terminate Program
  187.  
  188. COLOR White, Blue
  189. CLS
  190. END
  191.  
  192.